home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / graphics / gip_02.zip / COMMIE.BAS < prev    next >
BASIC Source File  |  1994-12-16  |  37KB  |  1,260 lines
  1.  
  2. '
  3. ' Commie r.03
  4. ' John David Rohner, Milwaukee, WI
  5. ' December 1994
  6. '
  7. ' Copyright (c) 1994, John Rohner.  All rights reserved.
  8. '
  9. 'Release History
  10. '
  11. '  .01  initial release
  12. '  .02  GIP BMP graphics support
  13. '  .03  save and restore the screen when shelling
  14. '       dropped Avatar support
  15. '       much faster modem-to-screen throughput so no fossil buffers needed
  16. '       dropped CGA icon-fixing support
  17. '       faster icon and BMP viewing
  18. '       286 or better now required
  19. '       should work with any fossil driver.
  20. '
  21. '
  22. DEFINT A-Z
  23. '
  24. ' Some constants and data types (from JDR_BBS).
  25. '
  26. CONST UpSC = 18432
  27. CONST DownSC = 20480
  28. CONST LeftSC = 19200
  29. CONST RightSC = 19712
  30. TYPE FileInfo                    'Len = 29
  31.   FName AS STRING * 12           'File name.
  32.   FSize AS LONG                  'File Size in bytes.
  33.   FDate AS STRING * 9            'File date (sometimes).
  34. END TYPE
  35. '
  36. ' General subroutine library (from JDR_BBS).
  37. '
  38. DECLARE SUB      Ansi (Inpt$)
  39. DECLARE FUNCTION AscMid% (Inpt$, BYVAL Start%)
  40. DECLARE FUNCTION AscNull% (Inpt$)
  41. DECLARE FUNCTION AscRight% (Inpt$)
  42. DECLARE SUB      BiosAnsi (st$)
  43. DECLARE FUNCTION BitsRol% (BYVAL Inpt%, BYVAL ShiftLeft%)
  44. DECLARE FUNCTION BitsRor% (BYVAL Inpt%, BYVAL ShiftRight%)
  45. DECLARE FUNCTION BitsShl% (BYVAL Inpt%, BYVAL ShiftLeft%)
  46. DECLARE FUNCTION BitsShr% (BYVAL Inpt%, BYVAL ShiftRight%)
  47. DECLARE FUNCTION BitTest% (BYVAL Inpt%, BYVAL BitNum%)
  48. DECLARE FUNCTION BlockIn% (BYVAL CommPort%, Send$)
  49. DECLARE SUB      BlockOut (BYVAL CommPort%, Send$)
  50. DECLARE SUB      ColorText (BYVAL Horiz%, BYVAL Vert%, BYVAL attr%,BYVAL char%)
  51. DECLARE SUB      CursorOff ()
  52. DECLARE SUB      CursorOn ()
  53. DECLARE SUB      DAMCSHLF (BYVAL Horiz%, BYVAL Vert%, Colors$, BYVAL i3%, BYVAL i4%)
  54. DECLARE SUB      Delay ()
  55. DECLARE SUB      DirCreate (st$)
  56. DECLARE SUB      FileClose (BYVAL Handle%)
  57. DECLARE SUB      FileGetSLoc (BYVAL Handle%, BYVAL Location&, Inpt$)
  58. DECLARE SUB      FileGetTD (BYVAL Handle%,i1%,i2%)
  59. DECLARE FUNCTION FileLof& (BYVAL Handle%, BYVAL Divisor%)
  60. DECLARE FUNCTION FileOpen% (FileName$,BYVAL attr%)
  61. DECLARE SUB      FilePutSEnd (BYVAL Handle%, Inpt$)
  62. DECLARE SUB      FileSetTD (BYVAL Handle%,BYVAL i1%,BYVAL i2%)
  63. DECLARE FUNCTION FindF% (File$, Typ AS FileInfo)
  64. DECLARE FUNCTION FindF2% (File$, Typ AS FileInfo)
  65. DECLARE FUNCTION FosIntAX% (BYVAL Port%, BYVAL AX%)
  66. DECLARE FUNCTION FosGetByte% (BYVAL Port%)
  67. DECLARE SUB      GLine (BYVAL CurrentH%, BYVAL CurrentV%, BYVAL TillH%, BYVAL TillV%, BYVAL Colr%, BYVAL GDither%)
  68. DECLARE SUB      GPixel (BYVAL Horiz%, BYVAL Vert%, BYVAL Colr%)
  69. DECLARE SUB      GSetMode (BYVAL GMode%, BYVAL VGA1%, BYVAL VGA2%)
  70. DECLARE FUNCTION HexToInt% (p$)
  71. DECLARE FUNCTION IntMid% (Inpt$, BYVAL Start%)
  72. DECLARE FUNCTION KBIn% ()
  73. DECLARE SUB      KillFile (File$)
  74. DECLARE FUNCTION LongMid& (Inpt$, BYVAL Start%)
  75. DECLARE SUB      RestScr (p$)
  76. DECLARE SUB      SaveScr (p$)
  77. DECLARE FUNCTION StrCrc16% (st$)
  78. DECLARE FUNCTION StrSrch1% (Inpt$, BYVAL Find%)
  79. DECLARE FUNCTION StrSrch2% (BYVAL Start%, Inpt$, BYVAL Find%)
  80. DECLARE SUB      zShell (DoWhat$)
  81. '
  82. ' Program specific subroutine library.
  83. '
  84. DECLARE SUB      Ansi2 (p$)
  85. DECLARE FUNCTION ConfirmFile% (p$)
  86. DECLARE SUB      DerCommie ()
  87. DECLARE SUB      DoGIPForComm ()
  88. DECLARE SUB      FileCloseR (p)
  89. DECLARE SUB      FileCloseW (p)
  90. DECLARE FUNCTION FileGetLine$ (p,p&)
  91. DECLARE FUNCTION FileOpenR% (p$)
  92. DECLARE FUNCTION FileOpenW% (p$)
  93. DECLARE FUNCTION FosGetB2000% ()
  94. DECLARE FUNCTION FosGetByte2% ()
  95. DECLARE SUB      GBox (p,p0,p1,p2,p3,p4)
  96. DECLARE SUB      GBoxFilled (p,p0,p1,p2,p3,p4)
  97. DECLARE SUB      GIPFileXfer ()
  98. DECLARE SUB      GIPParse1 (p$,p0$,p)
  99. DECLARE SUB      GIPParse2 (p$,p0,p1,p2)
  100. DECLARE SUB      HangUp ()
  101. DECLARE FUNCTION LineEditTT$ (p)
  102. DECLARE FUNCTION NoCarrier% ()
  103. DECLARE SUB      PurgeComIO (p)
  104. DECLARE SUB      ShowIcon2 (FileName$)
  105. DECLARE SUB      ShowBMP (FileName$)
  106. DECLARE FUNCTION Val4& (p$)  'to handle negatives.
  107. DECLARE SUB      ZeInit ()
  108.  
  109.  
  110.  
  111. '
  112. ' Global variables.
  113. '
  114. COMMON SHARED _
  115.   TT$, C1310$, Null$, Chars$(), o$(), FFile AS FileInfo, CommPort, DirectV, _
  116.   GInUse, GHoriz, GVert, GColor, GPattern, GPatShift, GObjects$(), Buff$, _
  117.   VGA1, VGA2
  118.  
  119.  
  120. '
  121. ' Actual program start.
  122. '
  123.  
  124.   C1310$ = CHR$(13) + CHR$(10)
  125.   CALL Ansi("Commie     GIP-able communications     release .03" + C1310$)
  126.   CALL Ansi("Copyright (C) John David Rohner 1994.  All rights reserved." + C1310$)
  127.   CALL ZeInit
  128.   CALL DerCommie
  129.  
  130. END
  131.  
  132.  
  133.  
  134. SUB DerCommie
  135.  
  136.     GInUse = 0
  137.     GHoriz = 1
  138.     GVert  = 1
  139.     GColor = 1
  140.     GPattern = 0
  141.     GPatShift = 0
  142.     KK$ = SPACE$(512)
  143. 1   SELECT CASE LEN(Buff$)
  144.       CASE 0
  145.            K = KBIn
  146.            SELECT CASE K
  147.              CASE IS < 1
  148.                   K = BlockIn(CommPort,KK$)
  149.                   SELECT CASE K
  150.                     CASE IS > 0
  151.                          K$ = LEFT$(KK$,K)
  152.                          K = StrSrch1(K$,19)
  153.                          IF K > 0 THEN Buff$ = MID$(K$,K + 1) : _
  154.                                        K$ = LEFT$(K$,K - 1)
  155.                          K0 = StrSrch1(K$,12)
  156.                          WHILE K0 > 0
  157.                            K$ = LEFT$(K$,K0 - 1) + "" + MID$(K$,K0 + 1)
  158.                            K0 = StrSrch1(K$,12)
  159.                          WEND
  160.                          CALL Ansi2(K$)
  161.                          IF K > 0 THEN CALL DoGIPForComm
  162.                   END SELECT
  163.              CASE 1 TO 255 : CALL BlockOut(CommPort,Chars$(K))
  164.              CASE UpSC     : CALL BlockOut(CommPort,"A")
  165.              CASE DownSC   : CALL BlockOut(CommPort,"B")
  166.              CASE LeftSC   : CALL BlockOut(CommPort,"D")
  167.              CASE RightSC  : CALL BlockOut(CommPort,"C")
  168.              CASE 15104    : CALL BlockOut(CommPort,o$(3,1))     '<F1>
  169.              CASE 15360    : CALL BlockOut(CommPort,o$(3,2))     '<F2>
  170.              CASE 15616    : CALL BlockOut(CommPort,o$(3,3))     '<F3>
  171.              CASE 15872    : CALL BlockOut(CommPort,o$(3,4))     '<F4>
  172.              CASE 16128    : CALL BlockOut(CommPort,o$(3,5))     '<F5>
  173.              CASE 16384    : CALL BlockOut(CommPort,o$(3,6))     '<F6>
  174.              CASE 16640    : CALL BlockOut(CommPort,o$(3,7))     '<F7>
  175.              CASE 16896    : CALL BlockOut(CommPort,o$(3,8))     '<F8>
  176.              CASE 17152    : CALL BlockOut(CommPort,o$(3,9))     '<F9>
  177.              CASE 17408    : CALL BlockOut(CommPort,o$(3,10))    '<F10>
  178.              CASE 8960 : CALL HangUp              '<alt>h
  179.              CASE 11520 : CALL HangUp             '<alt>x
  180.                           SYSTEM
  181.              CASE 7936
  182.                   '
  183.                   ' <alt>s  shell to DOS.
  184.                   '
  185.                   CALL CommieShell("")
  186.              CASE 11776                       ' <alt>c  reset the screen mode.
  187.                   CALL GSetMode(0,0,0)
  188.                   GInUse = 0
  189.                   TT$ = "COMMIE r.03  --  simple terminal program with GIP VGA graphics abilty" + C1310$ + C1310$
  190.                   TT$ = TT$ + "     Commands: <pgup>  to send file(s)         <alt>s  to shell to DOS" + C1310$
  191.                   TT$ = TT$ + "               <pgdn>  to receive file(s)      <alt>h  to hang up" + C1310$
  192.                   TT$ = TT$ + "               <alt>c  to reset the screen     <alt>x  to exit" + C1310$ + C1310$
  193.                   K0 = 1
  194.                   WHILE AscNull(o$(1,K0)) <> 0
  195.                     TT$ = TT$ + "│ " + o$(1,K0) + C1310$
  196.                     K0 = K0 + 1
  197.                   WEND
  198.                   TT$ = TT$ + C1310$ + ""
  199.                   CALL Ansi2(TT$)
  200.                   CALL CursorOn
  201.              CASE 18688
  202.                   '
  203.                   ' <pgup>  upload file(s).
  204.                   '
  205.                   IF GInUse <> 0 THEN CALL GSetMode(0,0,0) : _
  206.                                       GInUse = 0
  207.                   CALL Ansi2("BBB")
  208.                   K = 0
  209.                   K& = 0
  210.                   K$ = Null$
  211.                   DO
  212.                     s$ = SPACE$(4002)
  213.                     CALL SaveScr(s$)
  214.                     TT$ = "Sending: " + _
  215.                           STR$(K) + " files," + STR$(K&) + _
  216.                           " bytes.  Filename to send:  "
  217.                     SELECT CASE ConfirmFile(K0$)
  218.                       CASE -1
  219.                            K$ = K$ + K0$ + C1310$
  220.                            K0 = FindF(K0$,FFile)
  221.                            IF K0 <> 0 THEN DO : _
  222.                                              K = K + 1 : _
  223.                                              K& = K& + FFile.FSize : _
  224.                                            LOOP UNTIL FindF(Null$,FFile) = 0
  225.                     END SELECT
  226.                   LOOP UNTIL LEN(K0$) = 0
  227.                   SELECT CASE LEN(K$)
  228.                     CASE IS > 0
  229.                          K0$ = LEFT$(o$(2,3),3) + "COMMIE." + _
  230.                                LTRIM$(STR$(CommPort))
  231.                          K = FileOpenW(K0$)
  232.                          CALL FilePutSEnd(K,K$)
  233.                          CALL FileCloseW(K)
  234.                          IF NOT BitTest(FosIntAX(CommPort,&H300),15) _
  235.                             THEN CALL Delay
  236.                          K = FosIntAX(CommPort,&H0500)      'fossil off
  237.                          IF GInUse <> 0 THEN CALL GSetMode(0,0,0) : _
  238.                                              GInUse = 0
  239.                          LOCATE 25,1
  240.                          CALL zShell(o$(2,3) + STR$(CommPort) + " sz -mr @" + K0$)
  241.                          CALL KillFile(K0$)
  242.                          K = FosIntAX(CommPort,&H1C00)        'Fossil on.
  243.                   END SELECT
  244.                   CALL RestScr(s$)
  245.                   CALL Ansi2("")
  246.              CASE 20736
  247.                   '
  248.                   ' <pgdn>  download file(s).
  249.                   '
  250.                   CALL CommieShell(o$(2,3) + STR$(CommPort) + " rz -mr")
  251.            END SELECT
  252.       CASE ELSE
  253.            K$ = Buff$
  254.            K = StrSrch1(K$,19)
  255.            IF K = 0 THEN Buff$ = Null$ _
  256.                     ELSE Buff$ = MID$(K$,K + 1) : _
  257.                          K$ = LEFT$(K$,K - 1)
  258.            K0 = StrSrch1(K$,12)
  259.            WHILE K0 > 0
  260.              K$ = LEFT$(K$,K0 - 1) + "" + MID$(K$,K0 + 1)
  261.              K0 = StrSrch1(K$,12)
  262.            WEND
  263.            CALL Ansi2(K$)
  264.            IF K > 0 THEN CALL DoGIPForComm
  265.     END SELECT
  266.     GOTO 1
  267.  
  268. END SUB
  269.  
  270.  
  271. SUB CommieShell (p$)
  272.  
  273.   IF NOT BitTest(FosIntAX(CommPort,&H300),15) THEN CALL Delay
  274.   K = FosIntAX(CommPort,&H0500)      'fossil off
  275.   IF GInUse <> 0 THEN CALL GSetMode(0,0,0) : _
  276.                       GInUse = 0
  277.   s$ = SPACE$(4002)
  278.   CALL SaveScr(s$)
  279.   LOCATE 25,1
  280.   CALL zShell(p$)
  281.   CALL RestScr(s$)
  282.   K = FosIntAX(CommPort,&H1C00)        'Fossil on.
  283.   CALL Ansi2("")
  284.  
  285. END SUB
  286.  
  287.  
  288. '
  289. ' These next two GIP routines are pretty much exactly what's in the BBS's
  290. ' terminal program (COMMPROG.BAS).
  291. '
  292.  
  293.  
  294. SUB DoGIPForComm
  295.  
  296.   '
  297.   ' Get the key letter.
  298.   '
  299.   K = FosGetByte2
  300.   SELECT CASE K
  301.     CASE 76, 66, 70, 71, 77 : K0 = 3           'L, B, F, G, M
  302.     CASE 79, 80 : K0 = 2                       'O, P
  303.     CASE 83, 67, 111, 79 : K0 = 0              'S, C, o
  304.                            K1 = FosGetByte2
  305.     CASE ELSE : K0 = 0
  306.   END SELECT
  307.   '
  308.   ' Get any integer parameters.
  309.   '
  310.   FOR K5 = 1 TO K0
  311.     K3 = FosGetByte2
  312.     K4 = FosGetByte2
  313.     K3 = K3 OR BitsShl(K4,8)             'Want an integer.
  314.     IF K5 = 1 THEN K1 = K3
  315.     IF K5 = 2 THEN K2 = K3
  316.   NEXT
  317.   '
  318.   ' Process the key letter.
  319.   '
  320.   K4 = GHoriz
  321.   K5 = GVert
  322.   SELECT CASE K0
  323.     CASE 3
  324.          SELECT CASE GInUse
  325.            CASE 1, 3
  326.                 IF K1 > 320 THEN K = 0
  327.                 IF K2 > 200 THEN K = 0
  328.            CASE 2, 4
  329.                 IF K1 > 640 THEN K = 0
  330.                 IF K2 > 480 THEN K = 0
  331.            CASE 5
  332.                 IF K1 > 800 THEN K = 0
  333.                 IF K2 > 600 THEN K = 0
  334.          END SELECT
  335.   END SELECT
  336.   SELECT CASE K
  337.     CASE 71
  338.          '
  339.          ' Gh,v,d;  go to to point x,y,z.
  340.          '
  341.          GHoriz = K1
  342.          GVert = K2
  343.     CASE 76
  344.          '
  345.          ' Lh,v,d;  draw a line to offset h,v,d.
  346.          '
  347.          GHoriz = GHoriz + K1
  348.          GVert  = GVert + K2
  349.          IF GInUse > 0 THEN CALL GLine(K4,K5,GHoriz,GVert,GColor,GPattern)
  350.     CASE 66
  351.          '
  352.          ' Bh,v,d;  draw a rectangle to offset corner h,v,d.
  353.          '
  354.          IF GInUse > 0 _
  355.             THEN CALL GBox(GHoriz,GVert,GHoriz + K1,GVert + K2,GColor,GPattern)
  356.     CASE 70
  357.          '
  358.          ' Fh,v,d;  draw a filled/solid rectangle to offset corner h,v,d.
  359.          '
  360.          IF GInUse > 0 _
  361.             THEN CALL GBoxFilled(GHoriz,GVert,GHoriz + K1,GVert + K2,GColor,GPattern)
  362.     CASE 83
  363.          '
  364.          ' Sn;      switch to screen mode n.
  365.          '
  366.          GHoriz = 0
  367.          GVert  = 0
  368.          GColor = 15
  369.          GPattern = -1
  370.          GPatShift = 0
  371.          GInUse = K1
  372.          IF NOT DirectV THEN K1 = - K1
  373.          CALL GSetMode(K1,VGA1,VGA2)
  374.          CALL CursorOff
  375.          IF K1 = 0 THEN CALL CursorOn
  376.     CASE 67
  377.          '
  378.          ' Cn;      switch to color n.
  379.          '
  380.          GColor = K1
  381.     CASE 77
  382.          '
  383.          ' Mh,v,d;  go to to offset point h,v,d.
  384.          '
  385.          GHoriz = GHoriz + K1
  386.          GVert  = GVert + K2
  387.     CASE 80
  388.          '
  389.          ' Pn;      switch to pattern n.
  390.          '
  391.          GPattern = K1
  392.          IF GPattern = 0 THEN GPattern = -1
  393.          GPatShift = K2
  394.     CASE 102 : CALL GIPFileXfer
  395.     CASE 111
  396.          '
  397.          ' o###;   to use an object.  There must be no f cmds in it!
  398.          '
  399.          Buff$ = GObjects$(K1) + Buff$
  400.     CASE 79
  401.          '
  402.          ' O###;~Define~   to define an object.
  403.          '
  404.          SELECT CASE K1
  405.            CASE 1 TO 255
  406.                 K$ = Null$
  407.                 FOR K0 = 1 TO K2
  408.                   K$ = K$ + Chars$(FosGetByte2)
  409.                   IF NoCarrier OR LEN(K$) = 2049 THEN EXIT FOR
  410.                 NEXT
  411.                 K& = - LEN(GObjects$(K1))
  412.                 FOR K0 = 1 TO 255
  413.                   K& = K& + LEN(GObjects$(K1))
  414.                 NEXT
  415.                 K0$ = Null$
  416.                 K0 = 1
  417.                 DO
  418.                   K5 = AscMid(K$,K0)
  419.                   SELECT CASE K5
  420.                     CASE 19
  421.                          K2 = AscMid(K$,K0 + 1)
  422.                          CALL GIPParse1(K$,K1$,K0)
  423.                          K2$ = Null$
  424.                          IF LEN(K1$) = 0 THEN K2 = 0
  425.                          SELECT CASE K2
  426.                            CASE 83, 67, 111
  427.                                 K2$ = Chars$(Val4&(K1$))
  428.                            CASE 66, 70, 71, 76, 77
  429.                                 CALL GipParse2(K1$,K3,K4,0)
  430.                                 K2$ = MKI$(K3) + MKI$(K4) + MKI$(0)
  431.                            CASE 80
  432.                                 CALL GipParse2(K1$,K3,0,K4)
  433.                                 K2$ = MKI$(K3) + MKI$(K4)
  434.                          END SELECT
  435.                          IF LEN(K2$) > 0 _
  436.                             THEN K0$ = K0$ + Chars$(19) + Chars$(K2) + K2$
  437.                     CASE ELSE : K0$ = K0$ + Chars$(K5)
  438.                                 K0 = K0 + 1
  439.                   END SELECT
  440.                 LOOP UNTIL K0 > LEN(K$)
  441.                 IF K& + LEN(K0$) < 8193 THEN GObjects$(K1) = K0$
  442.          END SELECT
  443.   END SELECT
  444.  
  445. END SUB
  446.  
  447.  
  448.  
  449. SUB GIPFileXfer
  450.  
  451.   '
  452.   ' fpathname;  send a file.
  453.   '
  454.   ' Header info =  8  GIP ID (directory)(padded with spaces)
  455.   '               12  file name  (eg. "HELLO.ICO   ")
  456.   '                4  file's size
  457.   '                2  file's time
  458.   '                2  file's date
  459.   ' then send  INT CRC of the above.
  460.   ' then we send  byte of either: ACK, ENQ, <esc>
  461.   '
  462.   K = 0
  463.   DO
  464.     IF K = 5 OR KBIn = 27 OR NoCarrier _
  465.        THEN CALL BlockOut(CommPort,Chars$(27)) : _
  466.             EXIT SUB
  467.     IF K > 0 THEN CALL BlockOut(CommPort,Chars$(5))   'ENQ
  468.     K$ = Null$
  469.     FOR K0 = 1 TO 28
  470.       K$ = K$ + Chars$(FosGetByte2)
  471.     NEXT
  472.     K3 = FosGetByte2
  473.     K4 = FosGetByte2
  474.     K3 = K3 OR BitsShl(K4,8)             'Want an integer.
  475.     K = K + 1
  476.   LOOP UNTIL StrCrc16(K$) = K3
  477.   CALL BlockOut(CommPort,Chars$(6))       'ACK
  478.   K& = LongMid&(K$,21)
  479.   K1 = IntMid(K$,25)
  480.   K2 = IntMid(K$,27)
  481.   K0$ = "BBSSTUFF\" + RTRIM$(LEFT$(K$,8)) + "\" + RTRIM$(MID$(K$,9,12))
  482.   K = FindF(K0$,FFile)
  483.   SELECT CASE K
  484.     CASE IS <> 0
  485.          K = FileOpenR(K0$)
  486.          CALL FileGetTD(K,K3,K4)
  487.          CALL FileCloseR(K)
  488.          IF FFile.FSize <> K& OR K1 <> K3 OR K2 <> K4 THEN K = 0
  489.   END SELECT
  490.   SELECT CASE K
  491.     CASE 0      'Re-send file.
  492.          CALL BlockOut(CommPort,Chars$(5))      'Send an ENQ.
  493.          CALL DirCreate(K0$)
  494.          CALL KillFile(K0$)
  495.          K0& = 0
  496.          K3 = 0
  497.          IF K& > 1024 THEN K1$ = SPACE$(1024)
  498.          K = FileOpenW(K0$)
  499.          DO
  500.            IF K0& + 1024 > K& THEN K1$ = SPACE$(K& - K0&) : _
  501.                                    K3 = 0
  502.            K4 = LEN(K1$)
  503. 'kx$ = time$
  504.            DO
  505.              K0 = FosGetByte2
  506. '''check for stop/abort keys. (pull from dispfile).
  507.              IF K0 >= 0 THEN K3 = K3 + 1 : _
  508.                              MID$(K1$,K3,1) = Chars$(K0)
  509. '                            CALL StrOverStr1(K1$,K3,K0)
  510.            LOOP UNTIL K3 = K4 OR NoCarrier 'OR ElapsedTime(kx$,0) = 1
  511. ''line up the diskread's and diskwrites--but don't send the ACK until after
  512. ''write to disk (so on the sending end, read the next block after immediately
  513. ''send the previous, then wait for ACK).
  514.            IF K3 = K4 THEN CALL FilePutSEnd(K,K1$) : _
  515.                            CALL BlockOut(CommPort,Chars$(6)) : _
  516.                            K3 = 0 : _
  517.                            K0& = K0& + K4
  518.          LOOP UNTIL K0& = K& OR NoCarrier 'OR ElapsedTime(kx$,0) = 1
  519.          CALL FileSetTD(K,K1,K2)
  520.          CALL FileCloseW(K)
  521.     CASE ELSE   'File exists.
  522.          CALL BlockOut(CommPort,Chars$(6))
  523.   END SELECT
  524.   SELECT CASE FindF2(K0$,FFile)
  525.     CASE -1
  526.          SELECT CASE RIGHT$(K0$,4)
  527.            CASE ".ICO" : IF GInUse > 0 THEN CALL ShowIcon2(K0$)
  528.            CASE ".BMP" : IF GInUse > 0 THEN CALL ShowBMP(K0$)
  529.            CASE ELSE
  530.                 CALL GSetMode(0,0,0)
  531.                 GInUse = 0
  532.                 K = FileOpenR(K0$)
  533.                 K& = 0
  534.                 DO : CALL Ansi2(FileGetLine$(K,K&))
  535.                 LOOP UNTIL NoCarrier OR K& = -1
  536.                 CALL FileCloseR(K)
  537.          END SELECT
  538.   END SELECT
  539.  
  540. END SUB
  541.  
  542.  
  543.  
  544.  
  545. '
  546. ' Next few routines pulled from GIPSTUFF.BAS
  547. '
  548.  
  549.  
  550.         '* * * * * *
  551.         ' This routine will display an icon.
  552.         '
  553.         ' p$  pathname of file to use.
  554.         '
  555.         ' Date last checked for perfection: Oct 22 1993
  556.         '
  557. SUB ShowIcon2 (p$)
  558.  
  559.   K$ = SPACE$(16)
  560.   K = FileOpenR(p$)
  561.   CALL FileGetSLoc(K,6,K$)
  562.   K0 = ASC(K$)
  563.   K1 = AscMid(K$,2)
  564.   K2 = AscMid(K$,3)
  565.   K3 = LongMid&(K$,9)
  566.   K& = LongMid&(K$,13)
  567.  
  568.   K$ = SPACE$((K1 \ 2) * K0)
  569.   CALL FileGetSLoc(K,K& + 104,K$)
  570.   CALL FileCloseR(K)
  571.   CALL DAMCSHLF(GHoriz,GVert + K0,K$,K1 \ 2,4)
  572.  
  573. END SUB
  574.         '
  575.         '* * * *
  576.  
  577.  
  578. 'quick and dirty BMP viewer--trouble with the colors right now.
  579. 'also need to modify it so it draws at the current ghoriz/gvert?
  580. SUB ShowBMP (p$)
  581.  
  582.   K = FileOpenR(p$)
  583. zz$ = space$(27)
  584. call filegetsloc(k,2&,zz$)
  585.  
  586. k1& = longmid(zz$,1)      'end of image
  587. k& = longmid(zz$,9)       'start of image
  588. kx1 = intmid(zz$,17)      'horizontal width
  589. kx2 = intmid(zz$,21)      'vertical height
  590. kz = ascmid(zz$,27)       'number of pixels per color
  591.  
  592. aa = kx2
  593. if kz = 8 then xx = kx1 _
  594.           else xx = kx1 \ 2
  595.          xy = (16384 \ xx) * xx
  596.          x$ = space$(xy)
  597.          do
  598.            if (k1& - k&) < xy then x$ = left$(x$,k1& - k&)
  599.            CALL FileGetSLoc(K,k&,x$)
  600.            call DAMCSHLF(GHoriz,aa,x$,xx,kz)
  601.            k& = k& + xy
  602.            aa = aa - (xy \ xx)
  603.          loop until k& >= k1&
  604.   CALL FileCloseR(K)
  605.  
  606. END SUB
  607.  
  608.  
  609.  
  610.  
  611.         '* * * * * *
  612.         ' This routine will display an empty rectangle.
  613.         '
  614.         ' Date last checked for perfection: Oct 22 1993
  615.         '
  616. SUB GBox (p,p0,p1,p2,p3,p4)
  617.  
  618.   CALL GLine(p,p0,p1,p0,p3,p4)
  619.   CALL GLine(p1,p0,p1,p2,p3,p4)
  620.   CALL GLine(p1,p2,p,p2,p3,p4)
  621.   CALL GLine(p,p2,p,p0,p3,p4)
  622.  
  623. END SUB
  624.         '
  625.         '* * * *
  626.  
  627.  
  628.  
  629.         '* * * * * *
  630.         ' This routine will display a filled rectangle.
  631.         '
  632.         ' Date last checked for perfection: Oct 22 1993
  633.         '
  634. SUB GBoxFilled(p,p0,p1,p2,p3,p4)
  635.  
  636.   SELECT CASE p0
  637.     CASE IS <= p2
  638.          FOR K = p0 TO p2
  639.            CALL GLine(p,K,p1,K,p3,p4)
  640.            IF GPatShift < 0 _
  641.               THEN p4 = BitsROL(p4,- GPatShift) _
  642.               ELSE IF GPatShift > 0 THEN p4 = BitsROR(p4,GPatShift)
  643.          NEXT
  644.     CASE ELSE
  645.          FOR K = p0 TO p2 STEP -1
  646.            CALL GLine(p,K,p1,K,p3,p4)
  647.            IF GPatShift < 0 _
  648.               THEN p4 = BitsROL(p4,- GPatShift) _
  649.               ELSE IF GPatShift > 0 THEN p4 = BitsROR(p4,GPatShift)
  650.          NEXT
  651.   END SELECT
  652.  
  653. END SUB
  654.         '
  655.         '* * * *
  656.  
  657.  
  658.  
  659.  
  660.         '* * * * * *
  661.         ' This routine will parse a section of string, pulling out the
  662.         ' GIP string.
  663.         '
  664.         ' p$  string to process.
  665.         '
  666.         ' p0$ GIP string (excluding leading ASCII 19 and trailing semi-colon).
  667.         '
  668.         ' p   upon entry it points to the ASCII 19, upon return it points
  669.         '     just after the semi-colon.
  670.         '
  671.         ' Date last checked for perfection: Dec 7 1993
  672.         '
  673. SUB GIPParse1 (p$,p0$,p)
  674.  
  675.   K = StrSrch2(p,p$,59)
  676.   IF K > 0 AND LEN(p$) > 2 THEN p0$ = MID$(p$,p + 2,K - p - 2) : _
  677.                                 p = K + 1 _
  678.                            ELSE p0$ = Null$ : _
  679.                                 p = p + 1
  680.  
  681. END SUB
  682.         '
  683.         '* * * *
  684.  
  685.  
  686.  
  687.         '* * * * * *
  688.         ' This routine will parses a 3-D GIP string for its three
  689.         ' coordinates.
  690.         '
  691.         ' p$  string to process.
  692.         '
  693.         ' p0  returns with the h (first) coordinate.
  694.         '
  695.         ' p1  returns with the v (second) coordinate.
  696.         '
  697.         ' p2  returns with the d (third) coordinate.
  698.         '
  699.         ' Date last checked for perfection: Dec 7 1993
  700.         '
  701. SUB GIPParse2 (p$,p0,p1,p2)
  702.  
  703.   p0 = StrSrch1(p$,44)
  704.   p1 = StrSrch2(p0,p$,44)
  705.   IF p0 > 0 THEN p0 = Val4&(LEFT$(p$,p0 - 1))
  706.   IF p1 > 0 THEN p1 = Val4&(LEFT$(p$,p1 - 1))
  707.   p2 = Val4&(p$)
  708.  
  709. END SUB
  710.         '
  711.         '* * * *
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718. '
  719. ' Below this are just the support routines--the GIP stuff is above.
  720. '
  721.  
  722.  
  723.  
  724.  
  725.         '* * * * * *
  726.         ' This routine will read in our configuration data, and set up
  727.         ' some useful variables.
  728.         '
  729.         ' Date last checked for perfection: Oct 22 1993
  730.         '
  731. SUB ZeInit
  732.  
  733.   REDIM Chars$(255)
  734.   FOR K = 0 TO 255
  735.     Chars$(K) = CHR$(K)
  736.   NEXT
  737.   C1310$ = Chars$(13) + Chars$(10)
  738.   Null$ = ""
  739.   DirectV = 0
  740.   CommPort = 0
  741.   '
  742.   ' Load config file into o$().
  743.   '
  744.   REDIM o$(3,100)
  745.   K = FileOpenR("COMMIE.CFG")
  746.   K& = 0
  747.   K0 = 0
  748.   K1 = 0
  749.   o$(1,1) = Chars$(0)
  750.   DO 
  751.     K$ = FileGetLine$(K,K&)
  752.     SELECT CASE LEFT$(K$,5)
  753.       CASE "REMIN" : K1 = 1
  754.                      K0 = -1
  755.       CASE "SETTI" : K1 = 2
  756.                      o$(1,K0) = Chars$(0)
  757.                      K0 = -1
  758.       CASE "MACRO" : K1 = 3
  759.                      K0 = -1
  760.     END SELECT
  761.     K0 = K0 + 1
  762.     SELECT CASE K1
  763.       CASE 2
  764.            IF K0 = 1 THEN K2 = StrSrch1(K$,32) : _
  765.                           IF K2 > 0 THEN K$ = LEFT$(K$,K2)
  766.            IF K0 <> 3 AND K0 <> 1 THEN K$ = LEFT$(K$,7)
  767.            K$ = RTRIM$(K$)
  768.            IF K0 = 5 THEN VGA1 = HexToInt(K$)
  769.            IF K0 = 6 THEN VGA2 = HexToInt(K$)
  770.       CASE 3
  771.            K$ = MID$(K$,4)
  772.            K2 = StrSrch1(K$,124)
  773.            WHILE K2 > 0
  774.              K$ = LEFT$(K$,K2 - 1) + C1310$ + MID$(K$,K2 + 1)
  775.              K2 = StrSrch1(K$,124)
  776.            WEND
  777.     END SELECT
  778.     IF K1 > 0 THEN o$(K1,K0) = K$
  779.   LOOP UNTIL K& = -1
  780.   CALL FileCloseR(K)
  781.   '
  782.   ' Display opening screen and get comm port to use.
  783.   '
  784.   REDIM GObjects$(255)
  785.   TT$ = "COMMIE r.03  --  simple terminal program with GIP VGA graphics abilty" + C1310$ + C1310$
  786.   TT$ = TT$ + "     Commands: <pgup>  to send file(s)         <alt>s  to shell to DOS" + C1310$
  787.   TT$ = TT$ + "               <pgdn>  to receive file(s)      <alt>h  to hang up" + C1310$
  788.   TT$ = TT$ + "               <alt>c  to reset the screen     <alt>x  to exit" + C1310$ + C1310$
  789.   K0 = 1
  790.   WHILE AscNull(o$(1,K0)) <> 0
  791.     TT$ = TT$ + "│ " + o$(1,K0) + C1310$
  792.     K0 = K0 + 1
  793.   WEND
  794.   CALL Ansi2(TT$)
  795.   TT$ = C1310$ + "Port modem is connected to [1] :  "
  796.   CALL CursorOn
  797.   K$ = LineEditTT$(2)
  798.   IF ASCNull(K$) = 27 THEN SYSTEM
  799.   IF LEN(K$) > 0 THEN CommPort = ASC(K$) - 48 _
  800.                  ELSE CommPort = 1 : _
  801.                       CALL Ansi2("1")
  802.   '
  803.   'Make sure a fossil is installed, exit with message if not.
  804.   '
  805.   IF FosIntAX(CommPort,&H1C00) <> &H1954 _
  806.      THEN CALL Ansi2(C1310$ + C1310$ + "Fossil driver not found!" + C1310$) : _
  807.           CALL Delay : _
  808.           SYSTEM
  809.   '
  810.   ' Re-init fossil.
  811.   '
  812.   SELECT CASE o$(2,2)
  813.     CASE "38400" : K = 35               '001 00011
  814.     CASE "19200" : K = 3                '000 00011
  815.     CASE "9600"  : K = 227              '111 00011
  816.     CASE "1200"  : K = 131              '100 00011
  817.     CASE ELSE    : K = 163              '101 00011
  818.   END SELECT
  819.   K = FosIntAX(CommPort,K)
  820.   CALL Ansi2(C1310$ + C1310$ + "Type ATDT<phone#> to contact a BBS." + C1310$ + C1310$)
  821.   CALL BlockOut(CommPort,o$(2,1) + C1310$)
  822.   IF o$(2,4) = "DIRECT ON" THEN DirectV = -1
  823.   Buff$ = Null$
  824.  
  825. END SUB
  826.         '
  827.         '* * * *
  828.  
  829.  
  830.  
  831.         '* * * * * *
  832.         ' This routine will purge the fossil and modem I/O buffers.
  833.         '
  834.         ' p  Comm Port
  835.         '
  836.         ' It relies on the fossil to purge the modem buffers.
  837.         '
  838.         ' Date last checked for perfection: Oct 21 1993
  839.         '
  840. SUB PurgeComIO (p)
  841.  
  842.   k = FosIntAX(p,&HA00)                      'Purge the fossil's input buffer.
  843.   k = FosIntAX(p,&H900)                      'Purge the fossil's output buffer.
  844.   DO : k = FosGetB2000                       'Purge the modem's input buffer.
  845.   LOOP UNTIL k < 1                           'Just to be sure.
  846.  
  847. END SUB
  848.         '
  849.         '* * * *
  850.  
  851.  
  852.  
  853. FUNCTION FosGetB2000%
  854.  
  855.    K = FosIntAX(CommPort,&H0C00)   '-1 or 0 to 255 (peek)
  856.    IF K <> -1 THEN K = FosGetByte(CommPort)
  857.    FosGetB2000% = K
  858.  
  859. END FUNCTION
  860.  
  861.  
  862.  
  863.  
  864.         '* * * * * *
  865.         ' This routine will ANSI display text.
  866.         '
  867.         ' p$  text to display
  868.         '
  869.         ' Date last checked for perfection: Oct 21 1993
  870.         '
  871. SUB Ansi2 (p$)
  872.  
  873.   IF DirectV AND GInUse = 0 THEN CALL BiosAnsi(p$) : _
  874.                                  EXIT SUB
  875.   IF GInUse = 0 THEN CALL Ansi(p$) : _
  876.                      EXIT SUB
  877.   '
  878.   ' Graphic text drawing.
  879.   '
  880.   K$ = p$
  881.   WHILE LEN(K$) > 0
  882.     K = ASC(K$)
  883.     IF K = 10 THEN K = -1
  884.     IF K = 13 THEN GHoriz = 0 : _
  885.                    GVert = GVert + 8 : _
  886.                    K = -1
  887.     IF K >= 0 THEN CALL ColorText(GHoriz,GVert,GColor,K) : _
  888.                    GHoriz = GHoriz + 8
  889.     K$ = MID$(K$,2)
  890.   WEND
  891.  
  892. END SUB
  893.         '
  894.         '* * * *
  895.  
  896.  
  897.  
  898.  
  899.         '* * * * * *
  900.         ' This routine will signal Yea or Nay as to the status of the
  901.         ' carrier.
  902.         '
  903.         ' returns  -1 if no carrier detected
  904.         '           0 if carrier present
  905.         '
  906.         ' Remember, this is 'NO Carrier'--true when no carrier is
  907.         ' detected.
  908.         '
  909.         ' Date last checked for perfection: Oct 21 1993
  910.         '
  911. FUNCTION NoCarrier%
  912.  
  913.   IF BitTest(FosIntAX(CommPort,&H300),8) THEN NoCarrier% = 0 _
  914.                                          ELSE NoCarrier% = -1
  915.  
  916. END FUNCTION
  917.         '
  918.         '* * * *
  919.  
  920.  
  921.  
  922.  
  923.         '* * * * * *
  924.         ' This routine will hang up the phone.
  925.         '
  926.         ' Date last checked for perfection: Oct 21 1993
  927.         '
  928. SUB HangUp
  929.  
  930.   k = FosIntAX(CommPort,&H600)                  'Lower DTR.
  931.   CALL Delay
  932.   k = FosIntAX(CommPort,&H601)                  'Raise DTR.
  933.   CALL Delay
  934.   IF NoCarrier THEN CALL PurgeComIO(CommPort) : _
  935.                     EXIT SUB
  936.   DO
  937.     k = FosIntAX(CommPort,&H600)                  'Lower DTR.
  938.     CALL Delay
  939.     k = FosIntAX(CommPort,&H601)                  'Raise DTR.
  940.     CALL Delay
  941.   LOOP UNTIL NoCarrier
  942.   CALL PurgeComIO(CommPort)
  943.  
  944. END SUB
  945.         '
  946.         '* * * *
  947.  
  948.  
  949.  
  950.  
  951.               'in reverse to minimize -'ve rollover effects
  952. FUNCTION HexToInt% (p$)
  953.  
  954.   K$ = UCASE$(p$)
  955.   IF AscRight(K$) <> 72 THEN HexToInt% = Val4&(K$) : _
  956.                              EXIT FUNCTION
  957.   K$ = RIGHT$("0000" + LEFT$(K$,LEN(K$) - 1),4)
  958.   FOR K = 4 TO 1 STEP -1
  959.     K0 = AscMid(K$,K)
  960.     K0 = StrSrch1("0123456789ABCDEF",K0) - 1
  961.     SELECT CASE K
  962.       CASE 1 : K1 = K1 + K0 * 4096
  963.       CASE 2 : K1 = K1 + K0 * 256
  964.       CASE 3 : K1 = K1 + K0 * 16
  965.       CASE 4 : K1 = K0
  966.     END SELECT
  967.   NEXT
  968.   HexToInt% = K1
  969.  
  970. END FUNCTION
  971.  
  972.  
  973.  
  974.  
  975.  
  976.         '* * * * * *
  977.         ' This routine retrieves the next line of 'sequential' text
  978.         ' from an already opened file.
  979.         '
  980.         ' p   file handle to read from.
  981.         '
  982.         ' p&  location to start reading from.  p& is increased by the
  983.         '     size of the returned string + 2.  -1 is returned at EOF.
  984.         '
  985.         ' If the retrieved 128 byte buffer has no CR/LF, then returns
  986.         ' with all 128 bytes read.
  987.         '
  988.         ' A line with only a CR/LF on it is returned as a null.
  989.         '
  990.         ' The CR/LF is not included in the returned text.
  991.         '
  992.         ' At EOF, returned text may or may not contain text, but p&
  993.         ' will be -1.
  994.         '
  995.         ' The last line read may or may not contain data (assume it
  996.         ' does).
  997.         '
  998.         ' Date last checked for perfection: Oct 21 1993
  999.         '
  1000. FUNCTION FileGetLine$ (p,p&)
  1001.  
  1002.   k& = FileLof&(p,1) - 2
  1003.   IF p& >= k& OR p& < 0 THEN FileGetLine$ = Null$ : _
  1004.                              p& = -1 : _
  1005.                              EXIT FUNCTION
  1006.   k$ = SPACE$(128)
  1007.   k = 1
  1008.   DO
  1009.     IF k = 0 THEN K$ = K$ + K$    'we stop before it gets to 8192.
  1010.     CALL FileGetSLoc(p,p&,k$)
  1011.     k = StrSrch1(k$,13)
  1012.     WHILE K > 0 AND AscMid(K$,k + 1) <> 10
  1013.       K = StrSrch2(K,K$,13)
  1014.     WEND
  1015.     IF K = 0 AND p& + LEN(K$) > K& THEN K = StrSrch1(K$,0)
  1016.   LOOP UNTIL k <> 0 OR LEN(K$) >= 4096 OR p& + LEN(K$) > K&
  1017.   IF k > 0 THEN k$ = LEFT$(k$,k - 1) _
  1018.            ELSE k = LEN(K$)
  1019.   p& = p& + k + 1
  1020.   IF p& >= k& THEN p& = -1
  1021.   FileGetLine$ = k$
  1022.  
  1023. END FUNCTION
  1024.         '
  1025.         '* * * *
  1026.  
  1027.  
  1028.  
  1029.  
  1030.         '* * * * * *
  1031.         ' This routine will open a file in read-only, and read/write
  1032.         ' share mode.
  1033.         '
  1034.         ' p$  pathname of the file to open.
  1035.         '
  1036.         ' Date last checked for perfection: Oct 21 1993
  1037.         '
  1038. FUNCTION FileOpenR% (p$)
  1039.  
  1040.   K = FileOpen(p$,128)
  1041.   IF K = -1 THEN TT$ = C1310$ + C1310$ + _
  1042.                        "File error, unable to open " + _
  1043.                        p$ + "" + C1310$ + C1310$ : _
  1044.                  CALL Ansi(TT$) : _
  1045.                  SYSTEM
  1046.   FileOpenR% = K
  1047.  
  1048. END FUNCTION
  1049.         '
  1050.         '* * * *
  1051.  
  1052.  
  1053.  
  1054.  
  1055.         '* * * * * *
  1056.         ' This routine will close a file opened with FileOpenR.
  1057.         '
  1058.         ' p  handle of already-opened file.
  1059.         '
  1060.         ' Date last checked for perfection: Oct 21 1993
  1061.         '
  1062. SUB FileCloseR (p)
  1063.  
  1064.   CALL FileClose(p)
  1065.  
  1066. END SUB
  1067.         '
  1068.         '* * * *
  1069.  
  1070.  
  1071.  
  1072.         '* * * * * *
  1073.         ' This routine will get text input for a question answer.
  1074.         '
  1075.         ' p  maximum size of input allowed
  1076.         '
  1077.         ' The CR/LF is removed.
  1078.         '
  1079.         ' Date last checked for perfection: Oct 21 1993
  1080.         '
  1081. FUNCTION LineEditTT$ (p)
  1082.  
  1083.   CALL Ansi2(TT$)
  1084.   K0$ = SPACE$(p)
  1085.   K1 = 0
  1086.   DO
  1087.     K3 = KBIn
  1088.     SELECT CASE K3
  1089.       CASE IS < 1
  1090.       CASE IS > 255 : SYSTEM
  1091.       CASE 8, 127
  1092.           IF K1 > 0 THEN K1 = K1 - 1 : _
  1093.                          CALL Ansi2(Chars$(8) + " " + Chars$(8))
  1094.       CASE 27 : K0$ = Chars$(27)
  1095.                 EXIT DO
  1096.       CASE 13 : K0$ = LEFT$(K0$,K1)
  1097.                 EXIT DO
  1098.       CASE ELSE
  1099.            K1 = K1 + 1
  1100.            MID$(K0$,K1,1) = Chars$(K3)
  1101.            CALL Ansi2(Chars$(K3))
  1102.     END SELECT
  1103.   LOOP UNTIL K1 = p
  1104.   LineEditTT$ = K0$
  1105.  
  1106. END FUNCTION
  1107.         '
  1108.         '* * * *
  1109.  
  1110.  
  1111.  
  1112.         '* * * * * *
  1113.         ' This routine waits for the user to enter a pathname, and
  1114.         ' then confirms that it exists.
  1115.         '
  1116.         ' p$  returns with the pathname if found
  1117.         '
  1118.         ' returns with 0 if the file was not found, -1 if it was.
  1119.         '
  1120.         ' A SendTT is done, so just set TT or TT$ and call this.
  1121.         '
  1122.         ' A CR/LF is displayed no matter the result.
  1123.         '
  1124.         ' If the file is not found, p$ is not set to zero, but
  1125.         ' instead contains the pathname not found.  If [Enter]
  1126.         ' alone is hit, then NULL is returned in p$.
  1127.         '
  1128.         ' Date last checked for perfection: Oct 21 1993
  1129.         '
  1130. FUNCTION ConfirmFile% (p$)
  1131.  
  1132.   p$ = UCASE$(LTRIM$(RTRIM$(LineEditTT$(40))))
  1133.   IF LEN(p$) = 0 OR ASCNull(p$) = 27 THEN ConfirmFile% = 0 : _
  1134.                                           EXIT FUNCTION
  1135.   IF FindF(p$,FFile) <> 0 THEN ConfirmFile% = -1 : _
  1136.                                EXIT FUNCTION
  1137.   CALL Ansi2("  File not Found.")
  1138.   CALL Delay
  1139.   ConfirmFile% = 0
  1140.  
  1141. END FUNCTION
  1142.         '
  1143.         '* * * *
  1144.  
  1145.  
  1146.  
  1147.  
  1148.         '* * * * * *
  1149.         ' This routine will open a file for read/write and read-only
  1150.         ' share mode.
  1151.         '
  1152.         ' p$  pathname of the file to open.
  1153.         '
  1154.         ' Date last checked for perfection: Oct 21 1993
  1155.         '
  1156. FUNCTION FileOpenW% (p$)
  1157.  
  1158.   K = FileOpen(p$,130)
  1159.   IF K = -1 THEN TT$ = C1310$ + C1310$ + _
  1160.                        "File error, unable to open " + _
  1161.                        p$ + "" + C1310$ + C1310$ : _
  1162.                  CALL Ansi(TT$) : _
  1163.                  SYSTEM
  1164.   FileOpenW% = K
  1165.  
  1166. END FUNCTION
  1167.         '
  1168.         '* * * *
  1169.  
  1170.  
  1171.  
  1172.         '* * * * * *
  1173.         ' This routine will close a file opened with FileOpenW.
  1174.         '
  1175.         ' p  handle of already-opened file.
  1176.         '
  1177.         ' Date last checked for perfection: Oct 21 1993
  1178.         '
  1179. SUB FileCloseW (p)
  1180.  
  1181.   CALL FileClose(p)
  1182.  
  1183. END SUB
  1184.         '
  1185.         '* * * *
  1186.  
  1187.  
  1188.         '* * * * * *
  1189.         ' This routine will return a character from the port, or
  1190.         ' from the buffer.
  1191.         '
  1192.         ' Date last checked for perfection: Nov 10 1993
  1193.         '
  1194. FUNCTION FosGetByte2
  1195.  
  1196.   IF LEN(Buff$) > 0 _
  1197.      THEN K = ASC(Buff$) : _
  1198.           Buff$ = MID$(Buff$,2) _
  1199.      ELSE KK$ = SPACE$(2048) : _
  1200.           K = BlockIn(CommPort,KK$) : _
  1201.           IF K = 0 THEN K = FosGetByte(CommPort) _
  1202.                    ELSE Buff$ = MID$(KK$,2,K - 1) : _
  1203.                         K = ASC(KK$)
  1204.   FosGetByte2 = K
  1205.  
  1206. END FUNCTION
  1207.         '
  1208.         '* * * *
  1209.  
  1210.  
  1211.  
  1212.  
  1213.  
  1214. FUNCTION Val4& (p$)
  1215.  
  1216.   k& = 0
  1217.   k0& = 1
  1218.   K = LEN(RTRIM$(p$))
  1219.   SELECT CASE K
  1220.     CASE IS > 15
  1221.          K3 = 0
  1222.          FOR K0 = 0 TO 15
  1223.            K1 = AscMid(p$,K - K0) - 48
  1224.            IF K1 = 1 THEN CALL BitSet(K3,K0 + 1) _
  1225.                      ELSE IF K1 <> 0 THEN EXIT FOR
  1226.          NEXT
  1227.          IF K0 = 16 THEN K = -1 : _
  1228.                          K& = K3
  1229.   END SELECT
  1230.   K1 = 0
  1231.   SELECT CASE K
  1232.     CASE IS > 0
  1233.          DO
  1234.            K0 = AscMid(p$,K) - 48
  1235.            K1 = K1 + 1
  1236.            IF (K0 < 0) OR (K0 > 9) OR (K1 = 11) OR (K1 = 10 AND K0 > 1) _
  1237.               THEN EXIT DO
  1238.            k& = k& + k0& * K0
  1239.            k0& = 10 * k0&
  1240.            K = K - 1
  1241.          LOOP UNTIL K = 0
  1242.          IF K > 0 THEN IF AscMid(p$,K) = 45 THEN K& = - K&
  1243.   END SELECT
  1244.   Val4& = k&
  1245.  
  1246. END FUNCTION
  1247.  
  1248.  
  1249.  
  1250.  
  1251.  
  1252. '
  1253. ' to compile: BC COMMIE.BAS /O/S/FS/G2;
  1254. ' to link   : LINK /EXEPACK /PACKCODE COMMIE,,,ASSEMBLY\JDRBBS,,
  1255. ' requires  : BC.EXE, LINK.EXE, BCL70EFR.LIB, BRT70EFR.LIB, and JDRBBS.LIB
  1256. '             (Basic PDS 7.0+, and Juggernaut's assembly library)
  1257. '
  1258.  
  1259.  
  1260.